perm filename FMS[XX,LCS] blob sn#231808 filedate 1976-08-16 generic text, type C, neo UTF8
COMMENT āŠ—   VALID 00002 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002		TITLE FILLMS
C00009 ENDMK
CāŠ—;
	TITLE FILLMS
	ENTRY FILLMS
	EXTERNAL DL,DST,PLTR,LL,STF,FILLER,FLM
		; PUT THIS IN FILLX    FLM:	BLOCK =600
;******   CHANGE 3, 4 AND 5 TO JFCL IN DDT WHEN USING DISTORTION.(SEE 'LINES')
;	SUBROUTINE FILLMS(L,IDAT,R2,CENTR,R6,R7)
;	COMMON/DL/RSIZ,SAVER,NAME
;	COMMON/DST/BB,CC/FLM/X(600)
;	DIMENSION IDAT(1),NX(600)
;	EQUIVALENCE (NX,X)
;	COMMON/PLTR/IPLT,RHT,DIS/LL/LL/STF/RR(8),RSTJ2
; MD=DISPLAY   MP=PLOTTER   MX=XGP
;	DATA M2/2/
FILLMS:	0
	MOVE PLTR+2		;
	MOVEM DX#		;	DX=DIS
	MOVE PLTR+1		;	RX=RHT
	MOVEM RX#
	MOVE @4(16)		;	D=RSTJ2*R6
	FMPR STF+10
	MOVEM D#
	MOVE @5(16)		;	R=RSTJ2*R7
	FMPR STF+10
	MOVEM R#
	JRST FM1		;GO TO 1
	MOVE DST+1
	MOVEM C#		;	C=CC
	MOVE DST		;	B=BB
	MOVEM B#		;  SAVES IT.  IT WILL RETURN LATER.
	FDVR PLTR+2		;	BB=B/DIS
	MOVEM DST
	MOVE [1000.0]		;	CC=1000
	MOVEM DST+1
FM1:	MOVNI 13,2		;1	KK=-2
	SETZ 7			; KK IS 13,  J IS 7	DO 205 J=1,L
FM205:	ADDI 13,3		;	KK=KK+3
	MOVE 12,@1(16)		;	KX=KK+2
				 ;	SUBROUTINE UNPACK(M,N,I)
				;	COMMON/LL/L
				;C  L IS FOR VIS. OR INVIS. LINES.
	MOVEI	1,2	; L=2
 	MOVE	2,@2(16)	; N=I
	MOVE 4,2
	IDIV	2,[=100000000]  ;  M=N/100000000
	JUMPE	2,M2		; IF(M.EQ.0)GO TO 2
	AOJ 1,		; L=3
	MOVE 4,3		; N=N-100000000*M
				;M2:	MOVEM	1,LL
M2:	IDIVI	4,23420    ;2	M=N/10000
			; 5 IS  N=MOD(N,10000)
	CAIG	4,1750	; IF(M.GT.1000)M=1000-M
	JRST	N2
	MOVNS 4
	ADDI 4,1750
N2:	CAIG 5,1750	; IF(N.GT.1000)N=1000-N
	JRST	P2
	MOVNS 5
	ADDI 5,1750
				;P2:	MOVEM	4,@(16)
				;	MOVEM	5,@1(16)
				;	JRA	16,3(16)
				;JSA 16,UNPACK	  CALL UNPACK(M,N,IDAT(J))
				;	JUMP 10			;  M IS 10
				;	JUMP 11			;  N IS 11
				;	JUMP 12		;  12 IS IDAT ARRAY
				;	NX(KX)=2
				;LL IS FROM UNPACK	IF(LL.EQ.3)NX(KX)=3
P2:	MOVEM 1,FLM+1(5)	; LL (=2 PEN DN., =3 PEN UP.)
	FLTR 4 			;	X(KK)=(R2+D*M)*DIS
	FMPR D			;CC	X(KK)=ROFF((R2+D*M)*DIS)
	FADR @2(16)
	FMPR PLTR+2
	MOVEM FLM-1(5)
	FLTR 5 			;CC	X(KK+1)=ROFF((CENTR+R*N)*RHT)
	FMPR R			;	X(KK+1)=(CENTR+R*N)*RHT
	FADR @3(16)
	FMPR PLTR+1
	MOVE FLM(5)
	JRST FM3 		;3	GO TO 205
	MOVM FLM-1(5)
	FMPR DST		;	X(KK+1)=X(KK+1)*(C-BB*(ABS(X(KK))))
	MOVNS			;C  FOR DISTORTION
	FADR C
	FMPRM FLM(5)
	
FM3:	AOJ 7			;205	CONTINUE
	CAME @(16)
	JRST FM205
	ADDI 13,2		;	NX(3)=KX
	MOVEM 13,FLM+2
	MOVSI 201400
	MOVEM PLTR+2		;	DIS=1.0
	MOVEM PLTR+1		;	RHT=DIS
	MOVEI 10,1		;	IF(IPLT)M=RSIZ+.4
	MOVE [1.7]		;	IF(M.LE.0)M=1
	CAMLE DL		;	IF(M.GT.M2)M=M2
	AOJ 10			; AC 10 HAS FILL INCREMENT
	JSA 16,FILLER
	JUMP FLM
	JUMP 10
	MOVE DX			;2	CALL FILLER(NX,M)
	MOVEM PLTR+2		;	DIS=DX
	MOVE RX			;	RHT=RX
	MOVEM PLTR+1
FM5:	JRA 16,6(16)		;5	RETURN
	MOVE B			;C  NEXT TO RESET DISTORTION FACT.
	MOVEM DST		;	BB=B
	MOVE C			;	CC=C
	MOVEM DST+1
	JRA 16,6(16)		; 	RETURN
	END